home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJGRID4.CLS < prev    next >
Text File  |  1996-03-14  |  7KB  |  260 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjGrid3D"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private Xmin As Single      ' Min X and Y values.
  11. Private Zmin As Single
  12. Private Dx As Single        ' Spacing between rows of data.
  13. Private Dz As Single
  14. Private NumX As Integer     ' Number of X and Y entries.
  15. Private NumZ As Integer
  16. Private Points() As Point3D ' Data values.
  17.  
  18. ' ************************************************
  19. ' Return the value of Dz.
  20. ' ************************************************
  21. Property Get DeltaZ() As Single
  22.     DeltaZ = Dz
  23. End Property
  24. ' ************************************************
  25. ' Return the value of Dx.
  26. ' ************************************************
  27. Property Get DeltaX() As Single
  28.     DeltaX = Dx
  29. End Property
  30.  
  31. ' ************************************************
  32. ' Create the Points array.
  33. ' ************************************************
  34. Sub SetBounds(x1 As Single, DeltaX As Single, xnum As Integer, z1 As Single, DeltaZ As Single, znum As Integer)
  35. Dim i As Integer
  36. Dim j As Integer
  37. Dim x As Single
  38. Dim z As Single
  39.  
  40.     Xmin = x1
  41.     Zmin = z1
  42.     Dx = DeltaX
  43.     Dz = DeltaZ
  44.     NumX = xnum
  45.     NumZ = znum
  46.     ReDim Points(1 To NumX, 1 To NumZ)
  47.     
  48.     x = Xmin
  49.     For i = 1 To NumX
  50.         z = Zmin
  51.         For j = 1 To NumZ
  52.             Points(i, j).coord(1) = x
  53.             Points(i, j).coord(2) = 0
  54.             Points(i, j).coord(3) = z
  55.             Points(i, j).coord(4) = 1#
  56.             z = z + Dz
  57.         Next j
  58.         x = x + Dx
  59.     Next i
  60. End Sub
  61.  
  62. ' ************************************************
  63. ' Save the indicated data value.
  64. ' ************************************************
  65. Sub SetValue(x As Single, y As Single, z As Single)
  66. Dim i As Integer
  67. Dim j As Integer
  68.  
  69.     i = (x - Xmin) / Dx + 1
  70.     j = (z - Zmin) / Dz + 1
  71.     Points(i, j).coord(2) = y
  72. End Sub
  73.  
  74. ' ***********************************************
  75. ' Return a string indicating the object type.
  76. ' ***********************************************
  77. Property Get ObjectType() As String
  78.     ObjectType = "GRID"
  79. End Property
  80.  
  81.  
  82. ' ************************************************
  83. ' Draw the object into a metafile.
  84. ' ************************************************
  85. Public Sub MakeWMF(mhdc As Integer)
  86. Dim status As Long
  87. Dim i As Integer
  88. Dim j As Integer
  89.  
  90.     On Error Resume Next
  91.  
  92.     ' Draw the segments parallel to the Y axis.
  93.     For i = 1 To NumX
  94.         #If Win32 Then
  95.             status = API_MoveTo(mhdc, Points(i, 1).trans(1), Points(i, 1).trans(2), 0&)
  96.         #Else
  97.             status = API_MoveTo(mhdc, Points(i, 1).trans(1), Points(i, 1).trans(2))
  98.         #End If
  99.         
  100.         For j = 2 To NumZ
  101.             status = API_LineTo(mhdc, Points(i, j).trans(1), Points(i, j).trans(2))
  102.         Next j
  103.     Next i
  104.     
  105.     ' Draw the segments parallel to the X axis.
  106.     For j = 1 To NumZ
  107.         #If Win32 Then
  108.             status = API_MoveTo(mhdc, Points(1, j).trans(1), Points(1, j).trans(2), 0&)
  109.         #Else
  110.             status = API_MoveTo(mhdc, Points(1, j).trans(1), Points(1, j).trans(2))
  111.         #End If
  112.         For i = 2 To NumX
  113.             status = API_LineTo(mhdc, Points(i, j).trans(1), Points(i, j).trans(2))
  114.         Next i
  115.     Next j
  116. End Sub
  117.  
  118. ' ***********************************************
  119. ' Fix the data coordinates at their transformed
  120. ' values.
  121. ' ***********************************************
  122. Public Sub FixPoints()
  123. Dim i As Integer
  124. Dim j As Integer
  125. Dim k As Integer
  126.  
  127.     For i = 1 To NumX
  128.         For j = 1 To NumZ
  129.             For k = 1 To 3
  130.                 Points(i, j).coord(k) = Points(i, j).trans(k)
  131.             Next k
  132.         Next j
  133.     Next i
  134. End Sub
  135.  
  136. ' ************************************************
  137. ' Apply a transformation matrix which may not
  138. ' contain 0, 0, 0, 1 in the last column to the
  139. ' object.
  140. ' ************************************************
  141. Public Sub ApplyFull(M() As Single)
  142. Dim i As Integer
  143. Dim j As Integer
  144.  
  145.     For i = 1 To NumX
  146.         For j = 1 To NumZ
  147.             m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
  148.         Next j
  149.     Next i
  150. End Sub
  151.  
  152. ' ************************************************
  153. ' Apply a transformation matrix to the object.
  154. ' ************************************************
  155. Public Sub Apply(M() As Single)
  156. Dim i As Integer
  157. Dim j As Integer
  158.  
  159.     For i = 1 To NumX
  160.         For j = 1 To NumZ
  161.             m3Apply Points(i, j).coord, M, Points(i, j).trans
  162.         Next j
  163.     Next i
  164. End Sub
  165.  
  166.  
  167. ' ************************************************
  168. ' Apply a nonlinear transformation.
  169. ' ************************************************
  170. Public Sub Distort(D As Object)
  171. Dim i As Integer
  172. Dim j As Integer
  173.  
  174.     For i = 1 To NumX
  175.         For j = 1 To NumZ
  176.             D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
  177.         Next j
  178.     Next i
  179. End Sub
  180.  
  181. ' ************************************************
  182. ' Write a grid to a file using Write.
  183. ' Begin with "GRID" to identify this object.
  184. ' ************************************************
  185. Public Sub FileWrite(filenum As Integer)
  186. Dim i As Integer
  187. Dim j As Integer
  188.  
  189.     ' Write basic information.
  190.     Write #filenum, _
  191.         "GRID", Xmin, Zmin, Dx, Dz, NumX, NumZ
  192.         
  193.     ' Write the Z values.
  194.     For i = 1 To NumX
  195.         For j = 1 To NumZ
  196.             Write #filenum, Points(i, j).coord(2)
  197.         Next j
  198.     Next i
  199. End Sub
  200.  
  201.  
  202.  
  203. ' ************************************************
  204. ' Draw the transformed points on a Form, Printer,
  205. ' or PictureBox.
  206. ' ************************************************
  207. Public Sub Draw(canvas As Object, Optional R As Variant)
  208. Dim i As Integer
  209. Dim j As Integer
  210.  
  211.     On Error Resume Next
  212.         
  213.     ' Draw lines parallel to the X axis.
  214.     For i = 1 To NumX
  215.         canvas.CurrentX = Points(i, 1).trans(1)
  216.         canvas.CurrentY = Points(i, 1).trans(2)
  217.         For j = 2 To NumZ
  218.             canvas.Line -(Points(i, j).trans(1), _
  219.                           Points(i, j).trans(2))
  220.         Next j
  221.     Next i
  222.     
  223.     ' Draw lines parallel to the Y axis.
  224.     For j = 1 To NumZ
  225.         canvas.CurrentX = Points(1, j).trans(1)
  226.         canvas.CurrentY = Points(1, j).trans(2)
  227.         For i = 2 To NumX
  228.             canvas.Line -(Points(i, j).trans(1), _
  229.                           Points(i, j).trans(2))
  230.         Next i
  231.     Next j
  232. End Sub
  233.  
  234.  
  235. ' ************************************************
  236. ' Read a grid from a file using Input.
  237. ' Assume the "GRID" label has alreaDz been
  238. ' read.
  239. ' ************************************************
  240. Public Sub FileInput(filenum As Integer)
  241. Dim i As Integer
  242. Dim j As Integer
  243.  
  244.     ' Get the basic information.
  245.     Input #filenum, Xmin, Zmin, Dx, Dz, NumX, NumZ
  246.     
  247.     ' Allocate the Points array and set the X and
  248.     ' Y values.
  249.     SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ
  250.     
  251.     ' Read the Z values.
  252.     For i = 1 To NumX
  253.         For j = 1 To NumZ
  254.             Input #filenum, Points(i, j).coord(2)
  255.         Next j
  256.     Next i
  257. End Sub
  258.  
  259.  
  260.